home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyAEUtils.p < prev    next >
Text File  |  1997-02-26  |  14KB  |  468 lines
  1. unit MyAEUtils;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, Memory, Processes, Files, TextEdit, AppleEvents;
  7.  
  8.     const
  9.         typeMyPropertyToken = 'PTok';
  10.         myPropertiesResType = 'MPRP';
  11.  
  12.     type
  13.         SuspendedEvent = record
  14.                 waiting: boolean;
  15.                 event, reply: AppleEvent;
  16.                 dispatcher: AEEventHandlerUPP;
  17.                 refcon: longint;
  18.             end;
  19.  
  20.     function GotRequiredParams (var event: AppleEvent): OSErr;
  21.  
  22.     function AEGetDescPtr (desc: AEDesc; desiredType: DescType; p: Ptr; maximumSize: Size; var actualSize: Size): OSErr;
  23.  
  24.     procedure AECreate (var desc: AEDesc);
  25.     procedure AEDestroy (var desc: AEDesc); { dispose without error }
  26.     function AENull: AEDesc;
  27.  
  28.     function CreateStringDesc (s: Str255; var desc: AEDesc): OSErr;
  29.     function CreateLongDesc (n: longint; var desc: AEDesc): OSErr;
  30.     function CreateTypeDesc (t: DescType; var desc: AEDesc): OSErr;
  31.     function CreateSignatureDesc (t: DescType; var desc: AEDesc): OSErr;
  32.     function CreateProcessSerialNumberDesc (const psn: ProcessSerialNumber; var desc: AEDesc): OSErr;
  33.     function CreateBooleanDesc (b: boolean; var desc: AEDesc): OSErr;
  34.     function CreateFSSpecDesc (fs: FSSpec; var desc: AEDesc): OSErr;
  35.  
  36.     function CreateSelfTarget (var desc: AEDesc): OSErr;
  37.  
  38.     function GetDataFromAEDesc(var desc: AEDesc; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  39. { Guarentteed to preserve x on error }
  40.     function GetStringFromAEDesc (desc: AEDesc; var x: Str255): OSErr;
  41.     function GetLongFromAEDesc (desc: AEDesc; var x: longint): OSErr;
  42.     function GetTypeFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  43.     function GetBooleanFromAEDesc (desc: AEDesc; var x: boolean): OSErr;
  44.     function GetFSSpecFromAEDesc (desc: AEDesc; var x: FSSpec): OSErr;
  45.     function GetEnumeratedFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  46.  
  47.     function GetDataFromAERecord(var desc: AERecord; key: AEKeyword; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  48. { Guarentteed to preserve x on error }
  49.     function GetStringFromAERecord (var desc: AERecord; key: AEKeyword; var x: Str255): OSErr;
  50.     function GetLongFromAERecord (var desc: AERecord; key: AEKeyword; var x: longint): OSErr;
  51.     function GetTypeFromAERecord (var desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  52.     function GetBooleanFromAERecord (var desc: AERecord; key: AEKeyword; var x: boolean): OSErr;
  53.     function GetFSSpecFromAERecord (var desc: AERecord; key: AEKeyword; var x: FSSpec): OSErr;
  54.     function GetEnumeratedFromAERecord (var desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  55.  
  56.     function PutTESelectionToAERecord (var desc: AERecord; key: AEKeyword; te: TEHandle): OSErr;
  57.     function PutStringToAERecord (var desc: AERecord; key: AEKeyword; const s: Str255): OSErr;
  58.     function PutLongToAERecord (var desc: AERecord; key: AEKeyword; n: longint): OSErr;
  59.     function PutDateToAERecord (var desc: AERecord; key: AEKeyword; date: UInt32): OSErr;
  60.     function PutTypeToAERecord (var desc: AERecord; key: AEKeyword; t: DescType): OSErr;
  61.     function PutBooleanToAERecord (var desc: AERecord; key: AEKeyword; b: boolean): OSErr;
  62.     function PutFSSpecToAERecord (var desc: AERecord; key: AEKeyword; const fs: FSSpec): OSErr;
  63.  
  64.     procedure SendSelfSimpleEvent (class_id, event_id: AEEventID);
  65.  
  66.     function NullSuspendedEvent: SuspendedEvent;
  67.     function SuspendEvent (var event, reply: AppleEvent; dispatcher: AEEventHandlerUPP; refcon: longint; var se: SuspendedEvent): OSErr;
  68.     procedure ResumeEvent (var se: SuspendedEvent);
  69.  
  70. implementation
  71.  
  72.     uses
  73.         Memory, Resources, Errors, AEObjects, AERegistry;
  74.  
  75.     procedure AECreate (var desc: AEDesc);
  76.     begin
  77.         desc.descriptorType := typeNull;
  78.         desc.dataHandle := nil;
  79.     end;
  80.  
  81.     function AENull: AEDesc;
  82.         var
  83.             desc: AEDesc;
  84.     begin
  85.         AECreate(desc);
  86.         AENull := desc;
  87.     end;
  88.  
  89.     procedure AEDestroy (var desc: AEDesc);
  90.         var
  91.             junk: OSErr;
  92.     begin
  93.         junk := AEDisposeDesc(desc);
  94.         AECreate(desc);
  95.     end;
  96.  
  97.     function GotRequiredParams (var event: AppleEvent): OSErr;
  98.         var
  99.             typeCode: DescType;
  100.             actualSize: Size;
  101.             err: OSErr;
  102.     begin
  103.         err := AEGetAttributePtr(event, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize);
  104.         if err = errAEDescNotFound then begin        (* we got all the required params: all is ok *)
  105.             err := noErr;
  106.         end else if err = noErr then begin
  107.             err := errAEEventNotHandled
  108.         end;
  109.         GotRequiredParams := err;
  110.     end;
  111.  
  112.     function AEGetDescPtr (desc: AEDesc; desiredType: DescType; p: Ptr; maximumSize: Size; var actualSize: Size): OSErr;
  113.         var
  114.             err: OSErr;
  115.             result: AEDesc;
  116.             len: longint;
  117.     begin
  118.         actualSize := 0;
  119.         err := AECoerceDesc(desc, desiredType, result);
  120.         if err = noErr then begin
  121.             actualSize := GetHandleSize(result.dataHandle);
  122.             len := actualSize;
  123.             if len > maximumSize then begin
  124.                 len := maximumSize;
  125.             end;
  126.             BlockMoveData(result.dataHandle^, p, len);
  127.         end;
  128.         AEDestroy(result);
  129.         AEGetDescPtr := err;
  130.     end;
  131.  
  132.     function CreateSelfTarget (var desc: AEDesc): OSErr;
  133.         var
  134.             psn: ProcessSerialNumber;
  135.     begin
  136.         psn.lowLongOfPSN := kCurrentProcess;
  137.         psn.highLongOfPSN := 0;
  138.         CreateSelfTarget := AECreateDesc(typeProcessSerialNumber, @psn, SizeOf(psn), desc);
  139.     end;
  140.  
  141.     function CreateStringDesc (s: Str255; var desc: AEDesc): OSErr;
  142.     begin
  143.         CreateStringDesc := AECreateDesc(typeChar, @s[1], length(s), desc);
  144.     end;
  145.  
  146.     function CreateLongDesc (n: longint; var desc: AEDesc): OSErr;
  147.     begin
  148.         CreateLongDesc := AECreateDesc(typeLongInteger, @n, SizeOf(n), desc);
  149.     end;
  150.  
  151.     function CreateTypeDesc (t: DescType; var desc: AEDesc): OSErr;
  152.     begin
  153.         CreateTypeDesc := AECreateDesc(typeType, @t, SizeOf(t), desc);
  154.     end;
  155.  
  156.     function CreateSignatureDesc (t: DescType; var desc: AEDesc): OSErr;
  157.     begin
  158.         CreateSignatureDesc := AECreateDesc(typeApplSignature, @t, SizeOf(t), desc);
  159.     end;
  160.  
  161.     function CreateProcessSerialNumberDesc (const psn: ProcessSerialNumber; var desc: AEDesc): OSErr;
  162.     begin
  163.         CreateProcessSerialNumberDesc := AECreateDesc(typeProcessSerialNumber, @psn, SizeOf(psn), desc);
  164.     end;
  165.  
  166.     function CreateBooleanDesc (b: boolean; var desc: AEDesc): OSErr;
  167.     begin
  168.         CreateBooleanDesc := AECreateDesc(typeBoolean, @b, SizeOf(b), desc);
  169.     end;
  170.  
  171.     function CreateFSSpecDesc (fs: FSSpec; var desc: AEDesc): OSErr;
  172.     begin
  173.         CreateFSSpecDesc := AECreateDesc(typeFSS, @fs, SizeOf(fs), desc);
  174.     end;
  175.  
  176.     function GetStringFromAEDesc (desc: AEDesc; var x: Str255): OSErr;
  177.         var
  178.             result: AEDesc;
  179.             err: OSErr;
  180.             len: longint;
  181.     begin
  182.         err := AECoerceDesc(desc, typeChar, result);
  183.         if err = noErr then begin
  184.             len := GetHandleSize(result.dataHandle);
  185.             if len > 255 then begin
  186.                 len := 255;
  187.             end;
  188.             x[0] := chr(len);
  189.             BlockMoveData(result.dataHandle^, @x[1], len);
  190.             AEDestroy(result);
  191.         end;
  192.         GetStringFromAEDesc := err;
  193.     end;
  194.  
  195.     function GetDataFromAEDesc(var desc: AEDesc; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  196.         var
  197.             actual_size: Size;
  198.             err: OSErr;
  199.     begin
  200.         err := AEGetDescPtr(desc, typ, datap, datalen, actual_size);
  201.         if (err = noErr) & (datalen <> actual_size) then begin
  202.             err := -14;
  203.         end;
  204.         GetDataFromAEDesc := err;
  205.     end;
  206.     
  207.     function GetLongFromAEDesc (desc: AEDesc; var x: longint): OSErr;
  208.         var
  209.             len: longint;
  210.             err: OSErr;
  211.             temp: longint;
  212.     begin
  213.         err := AEGetDescPtr(desc, typeLongInteger, @temp, SizeOf(temp), len);
  214.         if err = noErr then begin
  215.             x := temp;
  216.         end;
  217.         GetLongFromAEDesc := err;
  218.     end;
  219.  
  220.     function GetTypeFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  221.         var
  222.             len: longint;
  223.             err: OSErr;
  224.             temp: DescType;
  225.     begin
  226.         err := AEGetDescPtr(desc, typeType, @temp, SizeOf(temp), len);
  227.         if err = noErr then begin
  228.             x := temp;
  229.         end;
  230.         GetTypeFromAEDesc := err;
  231.     end;
  232.  
  233.     function GetBooleanFromAEDesc (desc: AEDesc; var x: boolean): OSErr;
  234.         var
  235.             len: longint;
  236.             err: OSErr;
  237.             temp: boolean;
  238.     begin
  239.         err := AEGetDescPtr(desc, typeBoolean, @temp, SizeOf(temp), len);
  240.         if err = noErr then begin
  241.             x := temp;
  242.         end;
  243.         GetBooleanFromAEDesc := err;
  244.     end;
  245.  
  246.     function GetFSSpecFromAEDesc (desc: AEDesc; var x: FSSpec): OSErr;
  247.         var
  248.             err: OSErr;
  249.             len: longint;
  250.             temp: FSSpec;
  251.     begin
  252.         err := AEGetDescPtr(desc, typeFSS, @temp, SizeOf(temp), len);
  253.         if err = noErr then begin
  254.             x := temp;
  255.         end;
  256.         GetFSSpecFromAEDesc := err;
  257.     end;
  258.  
  259.     function GetEnumeratedFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  260.         var
  261.             err: OSErr;
  262.     begin
  263.         err := noErr;
  264.         if (GetHandleSize(desc.dataHandle) <> SizeOf(DescType)) then begin
  265.             err := errAETypeError;
  266.         end;
  267.         if err = noErr then begin
  268.             BlockMoveData(desc.dataHandle^, @x, SizeOf(x));
  269.         end;
  270.         GetEnumeratedFromAEDesc := err;
  271.     end;
  272.  
  273.     function GetStringFromAERecord (var desc: AERecord; key: AEKeyword; var x: Str255): OSErr;
  274.         var
  275.             dummy: DescType;
  276.             actual: Size;
  277.             err: OSErr;
  278.             temp: Str255;
  279.     begin
  280.     { AEGetKeyPtr changed to AEGetParamPtr }
  281.         err := AEGetParamPtr(desc, key, typeChar, dummy, @temp[1], 255, actual);
  282.         if err = noErr then begin
  283.             temp[0] := chr(actual);
  284.             x := temp;
  285.         end;
  286.         GetStringFromAERecord := err;
  287.     end;
  288.  
  289.     function GetDataFromAERecord(var desc: AERecord; key: AEKeyword; typ: DescType; datap: Ptr; datalen: longint): OSErr;
  290.         var
  291.             junk_type: DescType;
  292.             actual_size: Size;
  293.             err: OSErr;
  294.     begin
  295.         err := AEGetParamPtr(desc, key, typ, junk_type, datap, datalen, actual_size);
  296.         if (err = noErr) & (datalen <> actual_size) then begin
  297.             err := -14;
  298.         end;
  299.         GetDataFromAERecord := err;
  300.     end;
  301.     
  302.     function GetLongFromAERecord (var desc: AERecord; key: AEKeyword; var x: longint): OSErr;
  303.         var
  304.             dummy: DescType;
  305.             actual: Size;
  306.             err: OSErr;
  307.             temp: longint;
  308.     begin
  309.         err := AEGetParamPtr(desc, key, typeLongInteger, dummy, @temp, SizeOf(temp), actual);
  310.         if err = noErr then begin
  311.             x := temp;
  312.         end;
  313.         GetLongFromAERecord := err;
  314.     end;
  315.  
  316.     function GetTypeFromAERecord (var desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  317.         var
  318.             dummy: DescType;
  319.             actual: Size;
  320.             err: OSErr;
  321.             temp: DescType;
  322.     begin
  323.         err := AEGetParamPtr(desc, key, typeType, dummy, @temp, SizeOf(temp), actual);
  324.         if err = noErr then begin
  325.             x := temp;
  326.         end;
  327.         GetTypeFromAERecord := err;
  328.     end;
  329.  
  330.     function GetBooleanFromAERecord (var desc: AERecord; key: AEKeyword; var x: boolean): OSErr;
  331.         var
  332.             dummy: DescType;
  333.             actual: Size;
  334.             err: OSErr;
  335.             temp: boolean;
  336.     begin
  337.         err := AEGetParamPtr(desc, key, typeBoolean, dummy, @temp, SizeOf(temp), actual);
  338.         if err = noErr then begin
  339.             x := temp;
  340.         end;
  341.         GetBooleanFromAERecord := err;
  342.     end;
  343.  
  344.     function GetFSSpecFromAERecord (var desc: AERecord; key: AEKeyword; var x: FSSpec): OSErr;
  345.         var
  346.             dummy: DescType;
  347.             actual: Size;
  348.             err: OSErr;
  349.             temp: FSSpec;
  350.     begin
  351.         err := AEGetParamPtr(desc, key, typeFSS, dummy, @temp, SizeOf(temp), actual);
  352.         if err = noErr then begin
  353.             x := temp;
  354.         end;
  355.         GetFSSpecFromAERecord := err;
  356.     end;
  357.  
  358.     function GetEnumeratedFromAERecord (var desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  359.         var
  360.             err: OSErr;
  361.             value: AEDesc;
  362.     begin
  363.         err := AEGetParamDesc(desc, key, typeWildCard, value);
  364.         if err = noErr then begin
  365.             err := GetEnumeratedFromAEDesc(value, x);
  366.         end;
  367.         AEDestroy(value);
  368.         GetEnumeratedFromAERecord := err;
  369.     end;
  370.  
  371.     function PutTESelectionToAERecord (var desc: AERecord; key: AEKeyword; te: TEHandle): OSErr;
  372.         var
  373.             hhhh: Handle;
  374.             state: SignedByte;
  375.     begin
  376.         hhhh := Handle(TEGetText(te));
  377.         state := HGetState(hhhh);
  378.         HLock(hhhh);
  379.         PutTESelectionToAERecord := AEPutParamPtr(desc, key, typeChar, Ptr(ord(hhhh^) + te^^.selStart), te^^.selEnd - te^^.selStart);
  380.         HSetState(hhhh, state);
  381.     end;
  382.  
  383.     function PutStringToAERecord (var desc: AERecord; key: AEKeyword; const s: Str255): OSErr;
  384.     begin
  385.         PutStringToAERecord := AEPutParamPtr(desc, key, typeChar, @s[1], length(s));
  386.     end;
  387.  
  388.     function PutLongToAERecord (var desc: AERecord; key: AEKeyword; n: longint): OSErr;
  389.     begin
  390.         PutLongToAERecord := AEPutParamPtr(desc, key, typeLongInteger, @n, SizeOf(n));
  391.     end;
  392.  
  393.     function PutDateToAERecord (var desc: AERecord; key: AEKeyword; date: UInt32): OSErr;
  394.         var
  395.             longdate: record
  396.                     zero: longint;
  397.                     date: UInt32;
  398.                 end;
  399.     begin
  400.         longdate.zero := 0;
  401.         longdate.date := date;
  402.         PutDateToAERecord := AEPutParamPtr(desc, key, 'ldt ', @longdate, SizeOf(longdate)); { typeLongDateTime }
  403.     end;
  404.  
  405.     function PutTypeToAERecord (var desc: AERecord; key: AEKeyword; t: DescType): OSErr;
  406.     begin
  407.         PutTypeToAERecord := AEPutParamPtr(desc, key, typeType, @t, SizeOf(t));
  408.     end;
  409.  
  410.     function PutBooleanToAERecord (var desc: AERecord; key: AEKeyword; b: boolean): OSErr;
  411.     begin
  412.         PutBooleanToAERecord := AEPutParamPtr(desc, key, typeBoolean, @b, SizeOf(b));
  413.     end;
  414.  
  415.     function PutFSSpecToAERecord (var desc: AERecord; key: AEKeyword; const fs: FSSpec): OSErr;
  416.     begin
  417.         PutFSSpecToAERecord := AEPutParamPtr(desc, key, typeFSS, @fs, SizeOf(fs));
  418.     end;
  419.  
  420.     procedure SendSelfSimpleEvent (class_id, event_id: AEEventID);
  421.         var
  422.             event, reply: AppleEvent;
  423.             err, junk: OSErr;
  424.             target: AEDesc;
  425.     begin
  426.         AECreate(reply);
  427.         err := CreateSelfTarget(target);
  428.         err := AECreateAppleEvent(class_id, event_id, target, kAutoGenerateReturnID, kAnyTransactionID, event);
  429.         AEDestroy(target);
  430.         if err = noErr then begin
  431.             junk := AESend(event, reply, kAENoReply + kAEAlwaysInteract, kAENormalPriority, kAEDefaultTimeout, nil, nil);
  432.         end;
  433.         AEDestroy(event);
  434.         AEDestroy(reply);
  435.     end;
  436.  
  437.     function NullSuspendedEvent: SuspendedEvent;
  438.         var
  439.             se: SuspendedEvent;
  440.     begin
  441.         se.waiting := false;
  442.         NullSuspendedEvent := se;
  443.     end;
  444.  
  445.     function SuspendEvent (var event, reply: AppleEvent; dispatcher: AEEventHandlerUPP; refcon: longint; var se: SuspendedEvent): OSErr;
  446.         var
  447.             err: OSErr;
  448.     begin
  449.         se.event := event;
  450.         se.reply := reply;
  451.         se.dispatcher := dispatcher;
  452.         se.refcon := refcon;
  453.         err := AESuspendTheCurrentEvent(event);
  454.         se.waiting := err = noErr;
  455.         SuspendEvent := err;
  456.     end;
  457.  
  458.     procedure ResumeEvent (var se: SuspendedEvent);
  459.         var
  460.             junk: OSErr;
  461.     begin
  462.         if se.waiting then begin
  463.             se.waiting := false;
  464.             junk := AEResumeTheCurrentEvent(se.event, se.reply, se.dispatcher, se.refcon);
  465.         end;
  466.     end;
  467.  
  468. end.